<%
Class clsAccessHelper
  'Private Variables
  Private m_Conn        'As ADODB.Connection
  Private m_Command     'As ADODB.Command
  Private m_ConnString  'As String
  Private m_FilePath    'As String
  'Property
  Public Property Get ConnectionString()' As String
    ConnectionString = m_ConnString
  End Property

  Public Property Let ConnectionString(ByVal vNewValue)
    'ByVal vNewValue As String
    m_ConnString = vNewValue
  End Property

  Public Property Get IsReady()' As Boolean
    IsReady = IIf(Len(ConnectionString) > 0, True, False)
  End Property
  'Class Structure
  Private Sub Class_Initialize()
  End Sub

  Private Sub Class_Terminate()
    Set m_Conn = Nothing
    Set m_Command = Nothing
  End Sub
  'Private Functions
  Private Function m_NewCommand()
    Set m_NewCommand = Server.CreateObject("ADODB.Command")
  End Function

  Private Function m_NewConn()
    Set m_NewConn = Server.CreateObject("ADODB.Connection")
  End Function

  Private Sub OpenConn()
    Set m_Conn = m_NewConn()
    m_Conn.CursorLocation = adUseClient
    m_Conn.Open ConnectionString
  End Sub

  Private Sub CloseConn()
    m_Conn.Close
    Set m_Conn = Nothing
  End Sub

  Private Function m_ApostropheCount(ByVal SQL)' As Long
    'count number of "'"
    If SQL = Empty Then SQL = ""
    m_ApostropheCount = Len(SQL) - Len(Replace(SQL, "'", ""))
  End Function

  Private Function m_ProcessNameParams(mSql, mDic, mParams())' As Boolean
    'mSql As String, mDic As CHashTable, mParams() As Variant
    Dim mNewSql, mWord, mFieldName
    Dim mParamCount, i, comaCount
    Dim mBeginParam

    mNewSql = "" : mWord = "" : mFieldName = ""
    mParamCount = 0 : i = 0 : comaCount = 0
    mBeginParam = False
    
    If m_ApostropheCount(mSql) Mod 2 = 1 Then
      Err.Raise vbObjectError + 110000000, ,"Symbal "" '"" must be in pairs,please check SQL statement"
    End If

    For i = 1 To Len(mSql)
      mWord = Mid(mSql, i, 1)
      Select Case mWord
        Case " ", ",", ")"
          mNewSql = mNewSql & mWord
          If mBeginParam Then
            ReDim Preserve mParams(mParamCount)
            mParams(mParamCount) = mDic.Item(mFieldName)
            mFieldName = ""
            mParamCount = mParamCount + 1
          End If
          mBeginParam = False
        Case "'"
          comaCount = comaCount + 1
          mNewSql = mNewSql & mWord
        Case "@"
          If comaCount Mod 2 = 0 Then
            mBeginParam = True
            mNewSql = mNewSql & "?"
          Else
            'odd number of "'" means that "@" is only string of content
            mNewSql = mNewSql & mWord
          End If
        Case Else
          If mBeginParam = False Then
            mNewSql = mNewSql & mWord
          Else
            mFieldName = mFieldName & mWord
          End If
      End Select
    Next
    'all done but check last word for that last word maybe param
    If mFieldName <> "" Then
      ReDim Preserve mParams(mParamCount)
      mParams(mParamCount) = mDic.Item(mFieldName)
      mFieldName = ""
    End If
    'return
    mSql = mNewSql
    m_ProcessNameParams = True
  End Function

  Private Function m_GetVarType(ByRef Value)' As ADODB.DataTypeEnum
    'ByRef Value As Variant
    Select Case VarType(Value)
      Case vbString
        m_GetVarType = adVarWChar
      Case vbInteger
        m_GetVarType = adSmallInt
      Case vbBoolean
        m_GetVarType = adBoolean
      Case vbCurrency
        m_GetVarType = adCurrency
      Case vbDate
        m_GetVarType = adDate
      Case 8209
        m_GetVarType = adLongVarBinary
      Case Else
        m_GetVarType = adVariant
    End Select
  End Function
  'Public Functions
  Public Function DbConnFromFile(ByVal filePath)' As ADODB.Connection
    'ByVal filePath As String
    Dim mConn' As New ADODB.Connection

    Set mConn = m_NewConn
    mConn.CursorLocation = adUseClient
    mConn.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & filePath & ";"
    Set DbConnFromFile = mConn
  End Function

  Public Sub SetConnToFile(ByVal FilePath)
    'ByVal filePath As String
    m_ConnString = "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & FilePath & ";"
  End Sub

  Public Sub SetConnToSafeDB(ByVal FilePath, ByVal PassWord)
    m_ConnString = "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & FilePath & ";Persist Security Info=True;Jet OLEDB:Database Password=" & PassWord & ";"
  End Sub

  Public Sub SetConnToAccdb(ByVal filePath)
    'ByVal filePath As String
    m_ConnString = "Provider = Microsoft.ACE.OLEDB.12.0;Data Source=" & filePath & ";Persist Security Info=False"
  End Sub

  Public Function ExecQuery(ByVal SQL)' As ADODB.Recordset
    Dim mRes' As New ADODB.Recordset

    Set m_Command = m_NewCommand
    Call OpenConn
    m_Command.ActiveConnection = m_Conn
    m_Command.CommandText = SQL
    Set mRes = m_Command.Execute()
    'disconnect from database
    mRes.ActiveConnection = Nothing
    Call CloseConn
    Set ExecQuery = mRes
    Set m_Command = Nothing
  End Function

  Public Function ExecParamQuery(Byval SQL,ByVal Params())
    Dim mRes' As New Recordset
    Dim i      '' As Long
    Dim mParamArr' As Variant
    Dim mParam' As Variant

    Set m_Command = m_NewCommand
    '打开连接
    Call OpenConn
    m_Command.ActiveConnection = m_Conn
    m_Command.CommandText = SQL
    m_Command.CommandType = adCmdText

    '设置参数
    mParamArr = Params
    With m_Command
      For Each mParam In mParamArr
        Dim Para 'As ADODB.Parameter
        Set Para = .CreateParameter(CStr(i), m_GetVarType(mParam), adParamInput, LenB(mParam))
        Para.Value = mParam
        If VarType(mParam) = vbEmpty Then
          Para.Size = 1
        ElseIf VarType(mParam) = vbString Then
          If LenB(mParam) = 0 Then
            Para.Size = 1
          End If
        End If
        .Parameters.Append Para
      Next
    End With

    Set mRes = m_Command.Execute()
    mRes.ActiveConnection = Nothing
    Call CloseConn
    Set ExecParamQuery = mRes
    Set m_Command = Nothing
  End Function

  Public Function ExecNamedQuery(ByVal SQL, HashedParams)' As ADODB.Recordset
    Dim mParams()' As Variant
    m_ProcessNameParams SQL, HashedParams, mParams
    Set ExecNamedQuery = ExecParamQuery(SQL, mParams)
  End Function

  Public Function ExecNonQuery(ByVal SQL)' As Long
    Dim affectedRows' As Long

    Set m_Command = m_NewCommand
    Call OpenConn
    m_Command.ActiveConnection = m_Conn
    m_Command.CommandText = SQL
    m_Command.CommandType = adCmdText
    m_Command.Execute affectedRows
    Call CloseConn
    Set m_Command = Nothing
    ExecNonQuery = affectedRows
  End Function

  Public Function ExecParamNonQuery(ByVal SQL, ByVal Params())' As Long
    'ByVal SQL As String, ParamArray Params()
    Dim i, affectedRows
    Dim mParamArr, mParam

    i = 0 : affectedRows = 0

    Set m_Command = m_NewCommand
    Call OpenConn
    m_Command.ActiveConnection = m_Conn
    m_Command.CommandText = SQL
    m_Command.CommandType = adCmdText
    mParamArr = Params
    With m_Command
      For Each mParam In mParamArr
        Dim Para' As ADODB.Parameter

        Set Para = .CreateParameter(CStr(i), m_GetVarType(mParam), adParamInput, LenB(mParam))
        Para.Value = mParam
        If VarType(mParam) = vbEmpty Then
          Para.Size = 1
        ElseIf VarType(mParam) = vbString Then
          If LenB(mParam) = 0 Then
            Para.Size = 1
          End If
        End If
        .Parameters.Append Para
      Next
    End With

    m_Command.Execute affectedRows
    Call CloseConn
    Set m_Command = Nothing
    ExecParamNonQuery = affectedRows
  End Function

  Public Function ExecNamedNonQuery(ByVal SQL, HashedParams)' As Long
    Dim mParams()
    m_ProcessNameParams SQL, HashedParams, mParams
    ExecNamedNonQuery = ExecParamNonQuery(SQL, mParams)
  End Function

  Public Function ExecCreate(ByVal SQL)' As Variant
    Dim mRes

    Set m_Command = m_NewCommand
    Call OpenConn
    
    m_Command.ActiveConnection = m_Conn
    m_Command.CommandText = SQL
    m_Command.CommandType = adCmdText
    m_Command.Execute
    
    m_Command.CommandText = "SELECT @@identity"
    Set mRes = m_Command.Execute
    If mRes.RecordCount > 0 Then
      ExecCreate = mRes.Fields(0).Value
    Else
      ExecCreate = Empty
    End If
    Call CloseConn
    Set m_Command = Nothing
    Set mRes = Nothing
  End Function

  Public Function ExecParamCreate(ByVal SQL, ByVal Params())' As Variant
    Dim mParamArr, mParam
    Dim mRes
    Dim i

    Set m_Command = m_NewCommand
    Call OpenConn
    m_Command.ActiveConnection = m_Conn
    m_Command.CommandText = SQL
    m_Command.CommandType = adCmdText
    mParamArr = Params
    With m_Command
      For Each mParam In mParamArr
        Dim Para' As ADODB.Parameter

        Set Para = .CreateParameter(CStr(i), m_GetVarType(mParam), adParamInput, LenB(mParam))
        Para.Value = mParam
        If VarType(mParam) = vbEmpty Then
          Para.Size = 1
        ElseIf VarType(mParam) = vbString Then
          If LenB(mParam) = 0 Then
            Para.Size = 1
          End If
        End If
        .Parameters.Append Para
      Next
    End With

    m_Command.Execute
    m_Command.CommandText = "SELECT @@identity"
    Set mRes = m_Command.Execute
    If mRes.RecordCount > 0 Then
      ExecParamCreate = mRes.Fields(0).Value
    Else
      ExecParamCreate = Empty
    End If
    Call CloseConn
    Set m_Command = Nothing
    Set mRes = Nothing
  End Function

  Public Function ExecNamedCreate(ByVal SQL, HashedParams)' As Variant
    Dim mParams()' As Variant
    m_ProcessNameParams SQL, HashedParams, mParams
    ExecNamedCreate = ExecParamCreate(SQL, mParams)
  End Function

  Public Function ExecScalar(ByVal SQL)' As Variant
    Dim mRes
    
    Set mRes = ExecQuery(SQL)
    If mRes.RecordCount <= 0 Then
      ExecScalar = Empty
    Else
      ExecScalar = mRes.Fields(0).Value
    End If
    Set mRes = Nothing
  End Function

  Public Function ExecParamScalar(ByVal SQL, ByVal Params())' As Variant
    Dim mRes' As ADODB.Recordset
    
    If VarType(Params(0)) = 8204 Then
      Params = Params(0)
    End If
    
    Set mRes = ExecParamQuery(SQL, Params)
    If mRes.RecordCount <= 0 Then
      Set ExecParamScalar = Nothing
    Else
      ExecParamScalar = mRes.Fields(0).Value
    End If
    Set mRes = Nothing
  End Function

  Public Function ExecNamedScalar(ByVal SQL, HashedParams)' As Variant
    Dim mParams()' As Variant
    m_ProcessNameParams SQL, HashedParams, mParams
    ExecNamedScalar = ExecParamScalar(SQL, mParams)
  End Function
End Class
%>
<%
Const adUseClient = 3

Const adParamUnknown = &H0000&
Const adParamInput = &H0001&
Const adParamOutput = &H0002&
Const adParamInputOutput = &H0003&
Const adParamReturnValue = &H0004&

Const adCmdUnknown = &H0008&
Const adCmdText = &H0001&
Const adCmdTable = &H0002&
Const adCmdStoredProc = &H0004&
Const adCmdFile = &H0100&
Const adCmdTableDirect = &H0200&

Const adEmpty = 0 
Const adTinyInt = 16 
Const adSmallInt = 2 
Const adInteger = 3 
Const adBigInt = 20 
Const adUnsignedTinyInt = 17 
Const adUnsignedSmallInt = 18 
Const adUnsignedInt = 19 
Const adUnsignedBigInt = 21 
Const adSingle = 4 
Const adDouble = 5 
Const adCurrency = 6 
Const adDecimal = 14 
Const adNumeric = 131 
Const adBoolean = 11 
Const adError = 10 
Const adUserDefined = 132 
Const adVariant = 12 
Const adIDispatch = 9 
Const adIUnknown = 13 
Const adGUID = 72 
Const adDate = 7 
Const adDBDate = 133 
Const adDBTime = 134 
Const adDBTimeStamp = 135 
Const adBSTR = 8 
Const adChar = 129 
Const adVarChar = 200 
Const adLongVarChar = 201 
Const adWChar = 130 
Const adVarWChar = 202 
Const adLongVarWChar = 203 
Const adBinary = 128 
Const adVarBinary = 204 
Const adLongVarBinary = 205 
Const adChapter = 136 
Const adFileTime = 64 
Const adPropVariant = 138 
Const adVarNumeric = 139 
Const adArray = &H2000
%>